home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / fortran / toolpack.000 / toolpack / toolpack1.2 / tools / istan / ANLIB2.MAC.f < prev    next >
Encoding:
Text File  |  1989-03-04  |  54.9 KB  |  1,394 lines
  1. C---------------------------------------------------------
  2. C    TOOLPACK/1    Release: 2.3
  3. C---------------------------------------------------------
  4. C---------------------------------------------------------
  5. C    TOOLPACK/1    Release: 2.3
  6. C---------------------------------------------------------
  7. C ----------------------------------------------------------------------
  8. C
  9. C       I F B L K S   -   FORM BLOCK 'IF' STATEMENT FROM SIMPLE 'IF' FOR
  10. C                         SEGMENT MONITORING
  11. C
  12.  
  13.         SUBROUTINE IFBLKS
  14.  
  15. C---------------------------------------------------------
  16. C    TOOLPACK/1    Release: 2.3
  17. C---------------------------------------------------------
  18. C                  CONTROL VARIABLES
  19.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  20.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  21.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  22.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  23.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  24.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  25.      *         NSTMG,       NTREEG,      NTYPEG
  26.  
  27.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  28.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  29.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  30.      +          NTREEG,NTYPEG
  31.  
  32.         SAVE /CNTRLC/
  33.  
  34. C---------------------------------------------------------
  35. C    TOOLPACK/1    Release: 2.3
  36. C---------------------------------------------------------
  37.         COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
  38.         INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
  39.  
  40.         SAVE /IO/
  41.  
  42. C---------------------------------------------------------
  43. C    TOOLPACK/1    Release: 2.3
  44. C---------------------------------------------------------
  45. C                  KEYWORD ID VARIABLES
  46.       COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
  47.      *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
  48.      *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
  49.      *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
  50.      *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
  51.      *         KDOG,        KELSEG,      KELSFG,      KENDFG,
  52.      *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
  53.      *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
  54.      *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
  55.      *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
  56.      *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
  57.      *         KREADG,      KREALG,      KRETNG,      KRFUNG,
  58.      *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
  59.      *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
  60.      *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
  61.      *         LLINEG,      LSTMTG
  62.  
  63.         INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
  64.      +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
  65.      +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
  66.      +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
  67.      +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
  68.      +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
  69.      +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
  70.      +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
  71.         INTEGER KUFUNG,KSUBRG
  72.  
  73.         SAVE /KEYSC/
  74.  
  75. C---------------------------------------------------------
  76. C    TOOLPACK/1    Release: 2.3
  77. C---------------------------------------------------------
  78. C                  LOGICAL VARIABLES
  79.       COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
  80.      *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
  81.      *         HISTG,       IEOFG,       IFDOG,       INSRTG,
  82.      *         MAING,       SEGMTG,      STOPG,       TRACEG,
  83.      *         TREEG
  84.       LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
  85.      *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
  86.      *         IEOFG,       IFDOG,       INSRTG,      MAING,
  87.      *         SEGMTG,      STOPG,       TRACEG,      TREEG
  88.  
  89.         SAVE /LOGIC/
  90.  
  91. C---------------------------------------------------------
  92. C    TOOLPACK/1    Release: 2.3
  93. C---------------------------------------------------------
  94.         COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
  95.      +                MAXICH
  96.         INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
  97.      +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
  98.      +          MAXICH
  99.  
  100.         SAVE /TOKENS/
  101.  
  102. C
  103. C TOKTYP = array of token types for current statement
  104. C TOKLEN = parallel array of lengths of associated text strings
  105. C TXTPTR = parallel array of pointers into ISTMG character array of text
  106. C TOKEN = Current token number within statement being processed
  107. C NTOKSS = Number of tokens in statement
  108. C ISTTXT = IST text of token as read in before being converted by ZTOKTX
  109. C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
  110. C MAXICH = Last character used in ISTTXT array
  111. C
  112. C---------------------------------------------------------
  113. C    TOOLPACK/1    Release: 2.3
  114. C---------------------------------------------------------
  115.         COMMON/ANVNAM/VNAMEG
  116.         CHARACTER*5 VNAMEG
  117.         SAVE/ANVNAM/
  118. C---------------------------------------------------------
  119. C    TOOLPACK/1    Release: 2.3
  120. C---------------------------------------------------------
  121. C                  MAIN INTEGER STORAGE ARRAYS
  122. C MAXLBG = Maximum number of DO statement labels per routine
  123.         INTEGER MAXLBG
  124.         PARAMETER(MAXLBG=100)
  125.         COMMON / WORKC   /  IABEG(201),  ICRTNG(200), IPCNTG(75),
  126.      *         IRCNTG(75),  ISBEG(201),  ISCNTG(75),  INSTG(250),
  127.      *         KEXECG(75),  LABG(2,MAXLBG), KTOKG(81)
  128.         INTEGER IABEG,ICRTNG,IPCNTG,IRCNTG,ISBEG,ISCNTG,INSTG,
  129.      +          KEXECG,LABG,KTOKG
  130.         SAVE /WORKC/
  131.  
  132.         INTEGER ISEGL
  133.  
  134.         ISCNTG(ITYPEG) = ISCNTG(ITYPEG) + 1
  135.         IF (SEGMTG) THEN
  136.             CALL OUTSGS(NMSEG)
  137.             ISEGL=NMSEG
  138.             SEGMTG = .FALSE.
  139.         ELSE
  140.             ISEGL=0
  141.         END IF
  142.         CALL SEGMTS(.TRUE.)
  143.         ISCNTG(ITYPEG) = ISCNTG(ITYPEG) - 1
  144. C OUTPUT ANNOTATED STATEMENT
  145.         CALL OUTIFS(ISEGL,NMSEG)
  146. C SET UP BLOCK INSTRUMENTATION
  147.         NBUFFG=0
  148.         CALL SENDCH('     ')
  149.         CALL UNLABL
  150.         CALL SENDTK(1,NTOK2G)
  151.         CALL SENDCH('THEN')
  152. C OUTPUT 'IF' TEST AS 'IF-THEN' STATEMENT
  153.         CALL SEND
  154. C OUTPUT SEGMENT WITHIN 'IF-THEN' BLOCK
  155.         CALL OUTSGS(NMSEG)
  156.         IF (IFTYPG .EQ. KSTOPG) THEN
  157. C OUTPUT CALL TO WRAPUP ROUTINE FOR 'IF-STOP'
  158.             CALL OUTMSG('      CALL R'//VNAMEG,IODSCR)
  159.             STOPG = .TRUE.
  160.         ELSE
  161. C OUTPUT NORMAL 'IF' CONSEQUENCE AS SINGLE STMT
  162.             NBUFFG=0
  163.             CALL SENDTK(NTOK2G+1,NTOKSS)
  164.             CALL SEND
  165.         END IF
  166. C OUTPUT END OF 'IF' BLOCK
  167.         CALL OUTMSG('      ENDIF',IODSCR)
  168.  
  169.         END
  170. C ----------------------------------------------------------------------
  171. C
  172. C       I F D O S   -   SET UP TEST PORTION OF 'IF' WHICH ENDS A DO-LOOP
  173. C                       ,USING A CALL TO A LOGICAL INSTRUMENTING ROUTINE
  174. C
  175.  
  176.         SUBROUTINE IFDOS(ISEGA,JSEGA)
  177.         INTEGER ISEGA,JSEGA
  178.  
  179. C---------------------------------------------------------
  180. C    TOOLPACK/1    Release: 2.3
  181. C---------------------------------------------------------
  182. C                  CONTROL VARIABLES
  183.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  184.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  185.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  186.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  187.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  188.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  189.      *         NSTMG,       NTREEG,      NTYPEG
  190.  
  191.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  192.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  193.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  194.      +          NTREEG,NTYPEG
  195.  
  196.         SAVE /CNTRLC/
  197.  
  198. C---------------------------------------------------------
  199. C    TOOLPACK/1    Release: 2.3
  200. C---------------------------------------------------------
  201. C                  ROUTINE INSTRUMENTATION FLAGS
  202.       COMMON / INSTC   /    INST1G,      INST2G,      INST3G
  203.  
  204.         INTEGER INST1G,INST2G,INST3G
  205.  
  206.         SAVE /INSTC/
  207.  
  208. C---------------------------------------------------------
  209. C    TOOLPACK/1    Release: 2.3
  210. C---------------------------------------------------------
  211. C                  LOGICAL VARIABLES
  212.       COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
  213.      *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
  214.      *         HISTG,       IEOFG,       IFDOG,       INSRTG,
  215.      *         MAING,       SEGMTG,      STOPG,       TRACEG,
  216.      *         TREEG
  217.       LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
  218.      *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
  219.      *         IEOFG,       IFDOG,       INSRTG,      MAING,
  220.      *         SEGMTG,      STOPG,       TRACEG,      TREEG
  221.  
  222.         SAVE /LOGIC/
  223.  
  224. C---------------------------------------------------------
  225. C    TOOLPACK/1    Release: 2.3
  226. C---------------------------------------------------------
  227.         COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
  228.      +                MAXICH
  229.         INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
  230.      +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
  231.      +          MAXICH
  232.  
  233.         SAVE /TOKENS/
  234.  
  235. C
  236. C TOKTYP = array of token types for current statement
  237. C TOKLEN = parallel array of lengths of associated text strings
  238. C TXTPTR = parallel array of pointers into ISTMG character array of text
  239. C TOKEN = Current token number within statement being processed
  240. C NTOKSS = Number of tokens in statement
  241. C ISTTXT = IST text of token as read in before being converted by ZTOKTX
  242. C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
  243. C MAXICH = Last character used in ISTTXT array
  244. C
  245. C---------------------------------------------------------
  246. C    TOOLPACK/1    Release: 2.3
  247. C---------------------------------------------------------
  248.         COMMON/ANVNAM/VNAMEG
  249.         CHARACTER*5 VNAMEG
  250.         SAVE/ANVNAM/
  251. C---------------------------------------------------------
  252. C    TOOLPACK/1    Release: 2.4
  253. C---------------------------------------------------------
  254. C
  255. C  TKLAST = LAST TOKEN NUMBER
  256. C
  257.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  258.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  259.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  260.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  261.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  262.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  263.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  264.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  265.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  266.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  267.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  268.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  269.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  270.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  271.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  272.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  273.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  274.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  275.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  276.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  277.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  278.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  279.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  280.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  281.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  282.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  283.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  284.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  285.  
  286.  
  287.         INTEGER L
  288.  
  289. C Set up first constants
  290.         IFDOG = .TRUE.
  291.         INST3G = 1
  292.         IF (TOKTYP(1).EQ.TDCNST) THEN
  293.             CALL SENDTK(1,1)
  294.         ELSE
  295.             CALL SENDCH('      ')
  296.         END IF
  297.         CALL SENDCH('IF(L'//VNAMEG)
  298. C Send test portion of 'IF'
  299.         CALL SENDTK(NTOKG,NTOK2G-1)
  300. C Set up segment numbers
  301.         CALL SENDCH(',')
  302.         IF (ISEGA .EQ. 0) THEN
  303.             CALL SENDCH('0')
  304.         ELSE
  305. C Send unconditional segment
  306.             CALL SENDI(ISEGA)
  307.         END IF
  308.         CALL SENDCH(',')
  309.         IF (JSEGA .EQ. 0) THEN
  310.             CALL SENDCH('0')
  311.         ELSE
  312. C Send conditional segment
  313.             CALL SENDI(JSEGA)
  314.         END IF
  315.         CALL SENDCH('))')
  316.  
  317.         END
  318. C ----------------------------------------------------------------------
  319. C
  320. C       I F E N D S   -   SET UP 'IF' WHICH ENDS A DO-LOOP, AND OUTPUT
  321. C                         STATEMENT.
  322. C
  323.  
  324.         SUBROUTINE IFENDS(ISEGA,JSEGA)
  325.         INTEGER ISEGA,JSEGA
  326.  
  327. C---------------------------------------------------------
  328. C    TOOLPACK/1    Release: 2.3
  329. C---------------------------------------------------------
  330. C                  CONTROL VARIABLES
  331.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  332.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  333.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  334.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  335.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  336.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  337.      *         NSTMG,       NTREEG,      NTYPEG
  338.  
  339.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  340.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  341.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  342.      +          NTREEG,NTYPEG
  343.  
  344.         SAVE /CNTRLC/
  345.  
  346. C---------------------------------------------------------
  347. C    TOOLPACK/1    Release: 2.3
  348. C---------------------------------------------------------
  349. C                  KEYWORD ID VARIABLES
  350.       COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
  351.      *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
  352.      *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
  353.      *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
  354.      *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
  355.      *         KDOG,        KELSEG,      KELSFG,      KENDFG,
  356.      *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
  357.      *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
  358.      *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
  359.      *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
  360.      *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
  361.      *         KREADG,      KREALG,      KRETNG,      KRFUNG,
  362.      *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
  363.      *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
  364.      *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
  365.      *         LLINEG,      LSTMTG
  366.  
  367.         INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
  368.      +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
  369.      +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
  370.      +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
  371.      +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
  372.      +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
  373.      +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
  374.      +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
  375.         INTEGER KUFUNG,KSUBRG
  376.  
  377.         SAVE /KEYSC/
  378.  
  379. C---------------------------------------------------------
  380. C    TOOLPACK/1    Release: 2.3
  381. C---------------------------------------------------------
  382. C                  LOGICAL VARIABLES
  383.       COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
  384.      *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
  385.      *         HISTG,       IEOFG,       IFDOG,       INSRTG,
  386.      *         MAING,       SEGMTG,      STOPG,       TRACEG,
  387.      *         TREEG
  388.       LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
  389.      *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
  390.      *         IEOFG,       IFDOG,       INSRTG,      MAING,
  391.      *         SEGMTG,      STOPG,       TRACEG,      TREEG
  392.  
  393.         SAVE /LOGIC/
  394.  
  395. C---------------------------------------------------------
  396. C    TOOLPACK/1    Release: 2.3
  397. C---------------------------------------------------------
  398.         COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
  399.      +                MAXICH
  400.         INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
  401.      +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
  402.      +          MAXICH
  403.  
  404.         SAVE /TOKENS/
  405.  
  406. C
  407. C TOKTYP = array of token types for current statement
  408. C TOKLEN = parallel array of lengths of associated text strings
  409. C TXTPTR = parallel array of pointers into ISTMG character array of text
  410. C TOKEN = Current token number within statement being processed
  411. C NTOKSS = Number of tokens in statement
  412. C ISTTXT = IST text of token as read in before being converted by ZTOKTX
  413. C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
  414. C MAXICH = Last character used in ISTTXT array
  415. C
  416. C---------------------------------------------------------
  417. C    TOOLPACK/1    Release: 2.3
  418. C---------------------------------------------------------
  419.         COMMON/ANVNAM/VNAMEG
  420.         CHARACTER*5 VNAMEG
  421.         SAVE/ANVNAM/
  422.  
  423. C FORM FIRST PART OF INSTRUMENTED 'IF'
  424.         CALL IFDOS(ISEGA,JSEGA)
  425. C FORM LAST PART OF INSTRUMENTED 'IF'.
  426.         IF (IFTYPG .EQ. KSTOPG) THEN
  427. C 'STOP' CONSEQUENCE. ADD CALL TO WRAPUP ROUTINE.
  428.             STOPG = .TRUE.
  429.             CALL SENDCH('CALLR'//VNAMEG)
  430.         ELSE
  431. C OTHER CONSEQUENCE. ADD CONSEQUENCE.
  432.             CALL SENDTK(NTOK2G+1,NTOKSS)
  433.         END IF
  434. C OUTPUT INSTRUMENTED STATEMENT
  435.         CALL SEND
  436. C OUTPUT ANNOTATED STATEMENT
  437.         CALL OUTIFS(ISEGA,JSEGA)
  438.  
  439.         END
  440. C ----------------------------------------------------------------------
  441. C
  442. C       I N I T R S   -   INITIALISE ROUTINE-DEPENDENT VARIABLES
  443. C
  444.  
  445.         SUBROUTINE INITRS
  446.  
  447. C---------------------------------------------------------
  448. C    TOOLPACK/1    Release: 2.3
  449. C---------------------------------------------------------
  450. C Character variables and arrays, except for dictionaries & VNAMEG
  451.         INTEGER MAXCMG
  452.         PARAMETER(MAXCMG=30)
  453.         COMMON /CHARC/ IBUFFG,ICARDG,ICOMG,ISTMG,NAMEG
  454.  
  455.         CHARACTER IBUFFG(1326),ICARDG(72),ISTMG(1326)
  456.         CHARACTER*6 NAMEG
  457.         CHARACTER*72 ICOMG(MAXCMG)
  458.  
  459.         SAVE /CHARC/
  460. C---------------------------------------------------------
  461. C    TOOLPACK/1    Release: 2.3
  462. C---------------------------------------------------------
  463. C                  CONTROL VARIABLES
  464.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  465.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  466.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  467.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  468.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  469.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  470.      *         NSTMG,       NTREEG,      NTYPEG
  471.  
  472.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  473.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  474.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  475.      +          NTREEG,NTYPEG
  476.  
  477.         SAVE /CNTRLC/
  478.  
  479. C---------------------------------------------------------
  480. C    TOOLPACK/1    Release: 2.3
  481. C---------------------------------------------------------
  482. C Dictionary
  483. C   MAXDDG = Maximum number of dimension names in dictionary
  484. C   MAXRDG = Maximum number of routine names in dictionary
  485.         INTEGER MAXDDG,MAXRDG
  486.         PARAMETER(MAXDDG=150,MAXRDG=250)
  487.         COMMON /ANDICT/ DDICTG,RDICTG
  488.         CHARACTER*6 DDICTG(MAXDDG),RDICTG(MAXRDG)
  489.         SAVE /ANDICT/
  490. C---------------------------------------------------------
  491. C    TOOLPACK/1    Release: 2.3
  492. C---------------------------------------------------------
  493.         COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
  494.         INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
  495.  
  496.         SAVE /IO/
  497.  
  498. C---------------------------------------------------------
  499. C    TOOLPACK/1    Release: 2.3
  500. C---------------------------------------------------------
  501. C                  KEYWORD ID VARIABLES
  502.       COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
  503.      *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
  504.      *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
  505.      *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
  506.      *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
  507.      *         KDOG,        KELSEG,      KELSFG,      KENDFG,
  508.      *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
  509.      *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
  510.      *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
  511.      *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
  512.      *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
  513.      *         KREADG,      KREALG,      KRETNG,      KRFUNG,
  514.      *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
  515.      *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
  516.      *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
  517.      *         LLINEG,      LSTMTG
  518.  
  519.         INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
  520.      +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
  521.      +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
  522.      +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
  523.      +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
  524.      +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
  525.      +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
  526.      +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
  527.         INTEGER KUFUNG,KSUBRG
  528.  
  529.         SAVE /KEYSC/
  530.  
  531. C---------------------------------------------------------
  532. C    TOOLPACK/1    Release: 2.3
  533. C---------------------------------------------------------
  534. C                  LOGICAL VARIABLES
  535.       COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
  536.      *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
  537.      *         HISTG,       IEOFG,       IFDOG,       INSRTG,
  538.      *         MAING,       SEGMTG,      STOPG,       TRACEG,
  539.      *         TREEG
  540.       LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
  541.      *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
  542.      *         IEOFG,       IFDOG,       INSRTG,      MAING,
  543.      *         SEGMTG,      STOPG,       TRACEG,      TREEG
  544.  
  545.         SAVE /LOGIC/
  546.  
  547. C---------------------------------------------------------
  548. C    TOOLPACK/1    Release: 2.3
  549. C---------------------------------------------------------
  550.         COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
  551.      +                MAXICH
  552.         INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
  553.      +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
  554.      +          MAXICH
  555.  
  556.         SAVE /TOKENS/
  557.  
  558. C
  559. C TOKTYP = array of token types for current statement
  560. C TOKLEN = parallel array of lengths of associated text strings
  561. C TXTPTR = parallel array of pointers into ISTMG character array of text
  562. C TOKEN = Current token number within statement being processed
  563. C NTOKSS = Number of tokens in statement
  564. C ISTTXT = IST text of token as read in before being converted by ZTOKTX
  565. C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
  566. C MAXICH = Last character used in ISTTXT array
  567. C
  568. C---------------------------------------------------------
  569. C    TOOLPACK/1    Release: 2.3
  570. C---------------------------------------------------------
  571. C                  MAIN INTEGER STORAGE ARRAYS
  572. C MAXLBG = Maximum number of DO statement labels per routine
  573.         INTEGER MAXLBG
  574.         PARAMETER(MAXLBG=100)
  575.         COMMON / WORKC   /  IABEG(201),  ICRTNG(200), IPCNTG(75),
  576.      *         IRCNTG(75),  ISBEG(201),  ISCNTG(75),  INSTG(250),
  577.      *         KEXECG(75),  LABG(2,MAXLBG), KTOKG(81)
  578.         INTEGER IABEG,ICRTNG,IPCNTG,IRCNTG,ISBEG,ISCNTG,INSTG,
  579.      +          KEXECG,LABG,KTOKG
  580.         SAVE /WORKC/
  581. C---------------------------------------------------------
  582. C    TOOLPACK/1    Release: 2.4
  583. C---------------------------------------------------------
  584. C
  585. C  TKLAST = LAST TOKEN NUMBER
  586. C
  587.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  588.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  589.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  590.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  591.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  592.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  593.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  594.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  595.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  596.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  597.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  598.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  599.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  600.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  601.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  602.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  603.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  604.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  605.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  606.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  607.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  608.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  609.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  610.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  611.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  612.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  613.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  614.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  615.  
  616.  
  617.         CHARACTER*6 NAMEL
  618.         INTEGER ITOK,I,ISEG1L,IASR1L
  619.  
  620.         EXTERNAL ZCHOUT,ZPTINT,PUTCH
  621.  
  622. C PICK UP POSSIBLE NAME
  623.         NAMEL=' '
  624.         IF (ITYPEG.EQ.KPROGG .OR. ITYPEG.EQ.KBLOKG .OR.
  625.      +      ITYPEG.EQ.KSUBRG .OR. ITYPEG.EQ.KUFUNG .OR.
  626.      +      ITYPEG.EQ.KCFUNG .OR. ITYPEG.EQ.KXFUNG .OR.
  627.      +      ITYPEG.EQ.KDFUNG .OR. ITYPEG.EQ.KIFUNG .OR.
  628.      +      ITYPEG.EQ.KRFUNG .OR. ITYPEG.EQ.KLFUNG) THEN
  629.             ITOK=1
  630.  100        ITOK=ITOK+1
  631.             IF (TOKTYP(ITOK).NE.TNAME .AND. ITOK.LT.NTOKSS) GOTO 100
  632.             IF (TOKTYP(ITOK).EQ.TNAME)
  633.      +          CALL ZITOF(ISTTXT(ISTPTR(ITOK)),1,6,NAMEL,.FALSE.)
  634.         END IF
  635. C INITIALISE BY ROUTINE TYPE
  636.         IF (ITYPEG.EQ.KBLOKG) THEN
  637. C BLOCK DATA ROUTINE
  638.             BLKDTG = .TRUE.
  639.             IASR1L = 0
  640.             ISEG1L = 0
  641.             INSRTG = .TRUE.
  642.             MAING = .FALSE.
  643.             IF (NAMEL.NE.' ') THEN
  644.                 NAMEG = NAMEL
  645.             ELSE
  646.                 NAMEG = 'BLKDTA'
  647.             END IF
  648.         ELSE
  649. C NON-BLOCK DATA ROUTINE
  650.             BLKDTG = .FALSE.
  651.             EXECG = .FALSE.
  652.             INSRTG = .FALSE.
  653.             IERRG = 0
  654.             JERRG = 0
  655.             KERRG = 0
  656.             LABFLG = 0
  657.             NEDICG = 0
  658.             NDDICG = 0
  659.             NLABG = 0
  660.             SEGMTG = .FALSE.
  661.             CALL SEGMTS(.FALSE.)
  662.             IASR1L = NMASRG + 1
  663.             ISEG1L = NMSEG
  664.             IF (ITYPEG.EQ.KPROGG) THEN
  665. C MAIN PROGRAM WITH PROGRAM CARD
  666.                 MAING = .TRUE.
  667.                 NAMEG = NAMEL
  668.             ELSE IF (ITYPEG.EQ.KSUBRG .OR. ITYPEG.EQ.KUFUNG .OR.
  669.      +               ITYPEG.EQ.KCFUNG .OR. ITYPEG.EQ.KXFUNG .OR.
  670.      +               ITYPEG.EQ.KDFUNG .OR. ITYPEG.EQ.KIFUNG .OR.
  671.      *               ITYPEG.EQ.KLFUNG .OR. ITYPEG.EQ.KRFUNG) THEN
  672. C SUBROUTINE OR FUNCTION
  673.                 MAING = .FALSE.
  674.                 NAMEG = NAMEL
  675.                 CALL DARGS
  676.             ELSE
  677. C MAIN PROGRAM WITHOUT PROGRAM CARD
  678.                 MAING = .TRUE.
  679.                 NAMEG = 'MAIN'
  680.             END IF
  681. C SAVE ROUTINE NAME FOR PROGRAM CALL TREE
  682.             CALL NSAVES(NAMEG,RDICTG,NRDICG,MAXRDG,NCRTNG)
  683. C IF ROUTINE DICTIONARY OVERFLOW, STOP NOW.
  684.             IF (NCRTNG.EQ.0) CALL ERRORS(14)
  685. C SAVE ROUTINE STATS FOR INSTRUMENTED PROGRAM
  686.             NRTNG = NRTNG + 1
  687.             IABEG(NRTNG) = IASR1L
  688.             ISBEG(NRTNG) = ISEG1L
  689.             ICRTNG(NRTNG) = NCRTNG
  690.         END IF
  691. C OUTPUT FIRST STATEMENT TYPE SUMMARY FILE RECORD
  692. C FOR ROUTINE
  693.         CALL ZCHOUT(NAMEG//'.',IODSTS)
  694.         CALL PUTCH(32,IODSTS)
  695.         CALL ZPTINT(ISEG1L,1,IODSTS)
  696.         CALL PUTCH(32,IODSTS)
  697.         CALL ZPTINT(IASR1L,1,IODSTS)
  698.         CALL PUTCH(10,IODSTS)
  699.  
  700.         END
  701. C ----------------------------------------------------------------------
  702. C
  703. C       I N I T S S   -   INITIALIZE SYSTEM VARIABLES
  704. C
  705.  
  706.       SUBROUTINE INITSS
  707.  
  708. C---------------------------------------------------------
  709. C    TOOLPACK/1    Release: 2.3
  710. C---------------------------------------------------------
  711. C                  LOGICAL VARIABLES
  712.       COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
  713.      *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
  714.      *         HISTG,       IEOFG,       IFDOG,       INSRTG,
  715.      *         MAING,       SEGMTG,      STOPG,       TRACEG,
  716.      *         TREEG
  717.       LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
  718.      *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
  719.      *         IEOFG,       IFDOG,       INSRTG,      MAING,
  720.      *         SEGMTG,      STOPG,       TRACEG,      TREEG
  721.  
  722.         SAVE /LOGIC/
  723.  
  724. C---------------------------------------------------------
  725. C    TOOLPACK/1    Release: 2.3
  726. C---------------------------------------------------------
  727. C                  CONTROL VARIABLES
  728.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  729.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  730.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  731.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  732.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  733.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  734.      *         NSTMG,       NTREEG,      NTYPEG
  735.  
  736.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  737.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  738.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  739.      +          NTREEG,NTYPEG
  740.  
  741.         SAVE /CNTRLC/
  742.  
  743. C---------------------------------------------------------
  744. C    TOOLPACK/1    Release: 2.3
  745. C---------------------------------------------------------
  746. C                  ROUTINE INSTRUMENTATION FLAGS
  747.       COMMON / INSTC   /    INST1G,      INST2G,      INST3G
  748.  
  749.         INTEGER INST1G,INST2G,INST3G
  750.  
  751.         SAVE /INSTC/
  752.  
  753. C---------------------------------------------------------
  754. C    TOOLPACK/1    Release: 2.3
  755. C---------------------------------------------------------
  756. C                  KEYWORD ID VARIABLES
  757.       COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
  758.      *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
  759.      *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
  760.      *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
  761.      *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
  762.      *         KDOG,        KELSEG,      KELSFG,      KENDFG,
  763.      *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
  764.      *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
  765.      *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
  766.      *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
  767.      *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
  768.      *         KREADG,      KREALG,      KRETNG,      KRFUNG,
  769.      *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
  770.      *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
  771.      *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
  772.      *         LLINEG,      LSTMTG
  773.  
  774.         INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
  775.      +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
  776.      +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
  777.      +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
  778.      +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
  779.      +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
  780.      +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
  781.      +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
  782.         INTEGER KUFUNG,KSUBRG
  783.  
  784.         SAVE /KEYSC/
  785.  
  786. C---------------------------------------------------------
  787. C    TOOLPACK/1    Release: 2.3
  788. C---------------------------------------------------------
  789. C                  MAIN INTEGER STORAGE ARRAYS
  790. C MAXLBG = Maximum number of DO statement labels per routine
  791.         INTEGER MAXLBG
  792.         PARAMETER(MAXLBG=100)
  793.         COMMON / WORKC   /  IABEG(201),  ICRTNG(200), IPCNTG(75),
  794.      *         IRCNTG(75),  ISBEG(201),  ISCNTG(75),  INSTG(250),
  795.      *         KEXECG(75),  LABG(2,MAXLBG), KTOKG(81)
  796.         INTEGER IABEG,ICRTNG,IPCNTG,IRCNTG,ISBEG,ISCNTG,INSTG,
  797.      +          KEXECG,LABG,KTOKG
  798.         SAVE /WORKC/
  799.  
  800.         INTEGER L
  801.  
  802. C SET UP KEYWORDS
  803.         CALL KEYS
  804. C ZERO STATIC COUNTS
  805.         DO 100 L=1,NTYPEG
  806.             IPCNTG(L) = 0
  807.             IRCNTG(L) = 0
  808.   100       ISCNTG(L) = 0
  809.  
  810.         ARITHG = .FALSE.
  811.         BLKDTG = .FALSE.
  812.         CARD1G = .FALSE.
  813.         CGOTOG = .FALSE.
  814.         ENTRYG = .FALSE.
  815.         EXECG = .FALSE.
  816.         IFDOG = .FALSE.
  817.         INST1G = 0
  818.         INST2G = 0
  819.         INST3G = 0
  820.         ITYPEG = KENDG
  821.         LINEG = 50
  822.         LTYPEG = KENDG
  823.         MAING = .TRUE.
  824.         NEDICG = 0
  825.         NDDICG = 0
  826.         NLABG = 0
  827.         NMASRG = 0
  828.         NMSEG = 0
  829.         NRDICG = 0
  830.         NRTNG = 0
  831.         NTREEG = 0
  832.         STOPG = .FALSE.
  833.         TREEG = .TRUE.
  834.  
  835.       END
  836. C ----------------------------------------------------------------------
  837. C
  838. C       I N S R T S   -   INSERT MARKER IN SCRATCH INSTRUMENTATION FILE
  839. C                         INDICATING SPOT FOR INSERTION OF COMMON
  840. C                         BLOCKS FOR EACH ROUTINE.
  841. C
  842.  
  843.         SUBROUTINE INSRTS
  844.  
  845. C---------------------------------------------------------
  846. C    TOOLPACK/1    Release: 2.3
  847. C---------------------------------------------------------
  848. C                  LOGICAL VARIABLES
  849.       COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
  850.      *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
  851.      *         HISTG,       IEOFG,       IFDOG,       INSRTG,
  852.      *         MAING,       SEGMTG,      STOPG,       TRACEG,
  853.      *         TREEG
  854.       LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
  855.      *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
  856.      *         IEOFG,       IFDOG,       INSRTG,      MAING,
  857.      *         SEGMTG,      STOPG,       TRACEG,      TREEG
  858.  
  859.         SAVE /LOGIC/
  860.  
  861. C---------------------------------------------------------
  862. C    TOOLPACK/1    Release: 2.3
  863. C---------------------------------------------------------
  864. C                  CONTROL VARIABLES
  865.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  866.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  867.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  868.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  869.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  870.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  871.      *         NSTMG,       NTREEG,      NTYPEG
  872.  
  873.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  874.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  875.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  876.      +          NTREEG,NTYPEG
  877.  
  878.         SAVE /CNTRLC/
  879.  
  880. C---------------------------------------------------------
  881. C    TOOLPACK/1    Release: 2.3
  882. C---------------------------------------------------------
  883. C                  KEYWORD ID VARIABLES
  884.       COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
  885.      *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
  886.      *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
  887.      *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
  888.      *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
  889.      *         KDOG,        KELSEG,      KELSFG,      KENDFG,
  890.      *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
  891.      *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
  892.      *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
  893.      *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
  894.      *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
  895.      *         KREADG,      KREALG,      KRETNG,      KRFUNG,
  896.      *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
  897.      *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
  898.      *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
  899.      *         LLINEG,      LSTMTG
  900.  
  901.         INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
  902.      +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
  903.      +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
  904.      +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
  905.      +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
  906.      +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
  907.      +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
  908.      +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
  909.         INTEGER KUFUNG,KSUBRG
  910.  
  911.         SAVE /KEYSC/
  912.  
  913. C---------------------------------------------------------
  914. C    TOOLPACK/1    Release: 2.3
  915. C---------------------------------------------------------
  916.         COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
  917.         INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
  918.  
  919.         SAVE /IO/
  920.  
  921.  
  922.         EXTERNAL ZCHOUT,ZPTINT,PUTCH
  923.  
  924.         IF (ITYPEG.NE.KPROGG .AND. ITYPEG.NE.KSUBRG .AND.
  925.      +      ITYPEG.NE.KCFUNG .AND. ITYPEG.NE.KXFUNG .AND.
  926.      +      ITYPEG.NE.KDFUNG .AND. ITYPEG.NE.KIFUNG .AND.
  927.      +      ITYPEG.NE.KLFUNG .AND. ITYPEG.NE.KRFUNG .AND.
  928.      +      ITYPEG.NE.KUFUNG .AND. ITYPEG.NE.KFORMG .AND.
  929.      +      ITYPEG.NE.KNTRYG .AND. ITYPEG.NE.KPARAG .AND.
  930.      +      ITYPEG.NE.KIMPLG) THEN
  931. C INSERT MONITORING COMMON BLOCKS IN FIRST SPOT
  932. C FOLLOWING PROGRAM, SUBROUTINE, FUNCTION,
  933. C PARAMETER AND IMPLICIT STATEMENTS.
  934.             CALL ZCHOUT('$ ',IODSCR)
  935.             CALL ZPTINT(NCRTNG,1,IODSCR)
  936.             CALL PUTCH(10,IODSCR)
  937.             INSRTG = .TRUE.
  938.         END IF
  939.  
  940.         END
  941. C ----------------------------------------------------------------------
  942. C
  943. C       K E Y S   -   INITIALIZE SYSTEM STATEMENT TYPE DIRECTORY.
  944. C                     KEYWORDS ARE ORDERED AND USED FOR RECOGNITION
  945. C                     PURPOSES. OTHER DIRECTORY CODES ARE USED FOR
  946. C                     STATIC AND DYNAMIC COUNTS, AND CREATE
  947. C                     ADDITIONAL TYPES WHICH HAVE NO ASSOCIATED
  948. C                     KEYWORD.
  949. C                       - NO BLANKS IN KEYWORDS
  950. C                       - ORDER SIMILAR KEYWORDS WITH LONGER ONE FIRST.
  951. C                       - USE BLANKS TO ESTABLISH NON-KEYWORD.
  952. C                         ORDER NOT SIGNIFICANT FOR NON-KEYWORDS.
  953. C                       - ORDER DOES NOT IMPLY ORDER OF ANY OUTPUT
  954. C                         REPORTS, WHICH ARE FORMATTED SEPARATELY.
  955. C
  956.  
  957.         SUBROUTINE KEYS
  958.  
  959. C---------------------------------------------------------
  960. C    TOOLPACK/1    Release: 2.3
  961. C---------------------------------------------------------
  962. C                  CONTROL VARIABLES
  963.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  964.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  965.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  966.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  967.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  968.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  969.      *         NSTMG,       NTREEG,      NTYPEG
  970.  
  971.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  972.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  973.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  974.      +          NTREEG,NTYPEG
  975.  
  976.         SAVE /CNTRLC/
  977.  
  978. C---------------------------------------------------------
  979. C    TOOLPACK/1    Release: 2.3
  980. C---------------------------------------------------------
  981. C                  KEYWORD ID VARIABLES
  982.       COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
  983.      *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
  984.      *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
  985.      *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
  986.      *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
  987.      *         KDOG,        KELSEG,      KELSFG,      KENDFG,
  988.      *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
  989.      *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
  990.      *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
  991.      *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
  992.      *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
  993.      *         KREADG,      KREALG,      KRETNG,      KRFUNG,
  994.      *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
  995.      *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
  996.      *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
  997.      *         LLINEG,      LSTMTG
  998.  
  999.         INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
  1000.      +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
  1001.      +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
  1002.      +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
  1003.      +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
  1004.      +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
  1005.      +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
  1006.      +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
  1007.         INTEGER KUFUNG,KSUBRG
  1008.  
  1009.         SAVE /KEYSC/
  1010.  
  1011. C---------------------------------------------------------
  1012. C    TOOLPACK/1    Release: 2.4
  1013. C---------------------------------------------------------
  1014. C
  1015. C  TKLAST = LAST TOKEN NUMBER
  1016. C
  1017.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  1018.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  1019.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  1020.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  1021.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  1022.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  1023.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  1024.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  1025.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  1026.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  1027.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  1028.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  1029.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  1030.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  1031.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  1032.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  1033.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  1034.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  1035.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  1036.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  1037.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  1038.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  1039.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  1040.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  1041.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  1042.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  1043.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  1044.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  1045.  
  1046. C---------------------------------------------------------
  1047. C    TOOLPACK/1    Release: 2.3
  1048. C---------------------------------------------------------
  1049. C                  MAIN INTEGER STORAGE ARRAYS
  1050. C MAXLBG = Maximum number of DO statement labels per routine
  1051.         INTEGER MAXLBG
  1052.         PARAMETER(MAXLBG=100)
  1053.         COMMON / WORKC   /  IABEG(201),  ICRTNG(200), IPCNTG(75),
  1054.      *         IRCNTG(75),  ISBEG(201),  ISCNTG(75),  INSTG(250),
  1055.      *         KEXECG(75),  LABG(2,MAXLBG), KTOKG(81)
  1056.         INTEGER IABEG,ICRTNG,IPCNTG,IRCNTG,ISBEG,ISCNTG,INSTG,
  1057.      +          KEXECG,LABG,KTOKG
  1058.         SAVE /WORKC/
  1059.  
  1060.         INTEGER I
  1061.  
  1062.         NTYPEG=0
  1063.         DO 100 I=1,81
  1064.  100        KTOKG(I)=KNONEG
  1065.  
  1066. C ASSIGN
  1067.         CALL LOADTS(1,KASSNG)
  1068.         KTOKG(TASSIG)=KASSNG
  1069. C BACKSPACE
  1070.         CALL LOADTS(1,KBACKG)
  1071.         KTOKG(TBACKS)=KBACKG
  1072. C BLOCKDATA
  1073.         CALL LOADTS(0,KBLOKG)
  1074.         KTOKG(TBLOCK)=KBLOKG
  1075. C CALL
  1076.         CALL LOADTS(1,KCALLG)
  1077.         KTOKG(TCALL)=KCALLG
  1078. C CHARACTER FUNCTION
  1079.         CALL LOADTS(0,KCFUNG)
  1080. C CHARACTER
  1081.         CALL LOADTS(0,KCHARG)
  1082.         KTOKG(TCHARA)=KCHARG
  1083. C CLOSE
  1084.         CALL LOADTS(1,KCLOSG)
  1085.         KTOKG(TCLOSE)=KCLOSG
  1086. C COMMON
  1087.         CALL LOADTS(0,KCOMNG)
  1088.         KTOKG(TCOMMO)=KCOMNG
  1089. C COMPLEX FUNCTION
  1090.         CALL LOADTS(0,KXFUNG)
  1091. C COMPLEX
  1092.         CALL LOADTS(0,KCMPXG)
  1093.         KTOKG(TCOMPL)=KCMPXG
  1094. C DOUBLE COMPLEX treated as COMPLEX
  1095.         KTOKG(TDCMPL)=KCMPXG
  1096. C CONTINUE
  1097.         CALL LOADTS(1,KCONTG)
  1098.         KTOKG(TCONTI)=KCONTG
  1099. C DATA
  1100.         CALL LOADTS(0,KDATAG)
  1101.         KTOKG(TDATA)=KDATAG
  1102. C DIMENSION
  1103.         CALL LOADTS(0,KDIMNG)
  1104.         KTOKG(TDIMEN)=KDIMNG
  1105. C DOUBLEPRECISIONFUNCTION
  1106.         CALL LOADTS(0,KDFUNG)
  1107. C DOUBLEPRECISION
  1108.         CALL LOADTS(0,KDBLEG)
  1109.         KTOKG(TDOUBL)=KDBLEG
  1110. C DO
  1111.         CALL LOADTS(1,KDOG)
  1112.         KTOKG(TDO)=KDOG
  1113. C ELSEIF(
  1114.         CALL LOADTS(1,KELSFG)
  1115.         KTOKG(TELSIF)=KELSFG
  1116. C ELSE
  1117.         CALL LOADTS(1,KELSEG)
  1118.         KTOKG(TELSE)=KELSEG
  1119. C ENDFILE
  1120.         CALL LOADTS(1,KENDFG)
  1121.         KTOKG(TENDFI)=KENDFG
  1122. C ENDIF
  1123.         CALL LOADTS(1,KENDIG)
  1124.         KTOKG(TENDIF)=KENDIG
  1125. C END
  1126.         CALL LOADTS(1,KENDG)
  1127.         KTOKG(TEND)=KENDG
  1128. C ENTRY
  1129.         CALL LOADTS(0,KNTRYG)
  1130.         KTOKG(TENTRY)=KNTRYG
  1131. C EQUIVALENCE
  1132.         CALL LOADTS(0,KEQIVG)
  1133.         KTOKG(TEQUIV)=KEQIVG
  1134. C EXTERNAL
  1135.         CALL LOADTS(0,KEXTLG)
  1136.         KTOKG(TEXTER)=KEXTLG
  1137. C FORMAT
  1138.         CALL LOADTS(0,KFORMG)
  1139.         KTOKG(TFORMA)=KFORMG
  1140. C FUNCTION
  1141.         CALL LOADTS(0,KUFUNG)
  1142.         KTOKG(TFUNCT)=KUFUNG
  1143. C GOTO
  1144.         CALL LOADTS(1,KUGOG)
  1145.         KTOKG(TGOTO)=KUGOG
  1146. C IF(
  1147.         CALL LOADTS(1,KLIFG)
  1148.         KTOKG(TIF)=KLIFG
  1149. C IMPLICIT
  1150.         CALL LOADTS(0,KIMPLG)
  1151.         KTOKG(TIMPLI)=KIMPLG
  1152. C INQUIRE
  1153.         CALL LOADTS(1,KINQRG)
  1154.         KTOKG(TINQUI)=KINQRG
  1155. C INTEGER FUNCTION
  1156.         CALL LOADTS(0,KIFUNG)
  1157. C INTEGER
  1158.         CALL LOADTS(0,KINTEG)
  1159.         KTOKG(TINTEG)=KINTEG
  1160. C INTRINSIC
  1161.         CALL LOADTS(0,KINSCG)
  1162.         KTOKG(TINTRI)=KINSCG
  1163. C LOGICAL FUNCTION
  1164.         CALL LOADTS(0,KLFUNG)
  1165. C LOGICAL
  1166.         CALL LOADTS(0,KLOGCG)
  1167.         KTOKG(TLOGIC)=KLOGCG
  1168. C OPEN
  1169.         CALL LOADTS(1,KOPENG)
  1170.         KTOKG(TOPEN)=KOPENG
  1171. C PARAMETER
  1172.         CALL LOADTS(0,KPARAG)
  1173.         KTOKG(TPARAM)=KPARAG
  1174. C PAUSE
  1175.         CALL LOADTS(1,KPAUSG)
  1176.         KTOKG(TPAUSE)=KPAUSG
  1177. C PRINT
  1178.         CALL LOADTS(1,KPRNTG)
  1179.         KTOKG(TPRINT)=KPRNTG
  1180. C PROGRAM
  1181.         CALL LOADTS(0,KPROGG)
  1182.         KTOKG(TPROGR)=KPROGG
  1183. C READ
  1184.         CALL LOADTS(1,KREADG)
  1185.         KTOKG(TREAD)=KREADG
  1186. C REAL FUNCTION
  1187.         CALL LOADTS(0,KRFUNG)
  1188. C REAL
  1189.         CALL LOADTS(0,KREALG)
  1190.         KTOKG(TREAL)=KREALG
  1191. C RETURN
  1192.         CALL LOADTS(1,KRETNG)
  1193.         KTOKG(TRETUR)=KRETNG
  1194. C REWIND
  1195.         CALL LOADTS(1,KWINDG)
  1196.         KTOKG(TREWIN)=KWINDG
  1197. C SAVE
  1198.         CALL LOADTS(0,KSAVEG)
  1199.         KTOKG(TSAVE)=KSAVEG
  1200. C STOP
  1201.         CALL LOADTS(1,KSTOPG)
  1202.         KTOKG(TSTOP)=KSTOPG
  1203. C SUBROUTINE
  1204.         CALL LOADTS(0,KSUBRG)
  1205.         KTOKG(TSUBRO)=KSUBRG
  1206. C WRITE
  1207.         CALL LOADTS(1,KWRITG)
  1208.         KTOKG(TWRITE)=KWRITG
  1209. C ASSIGNED GOTO
  1210.         CALL LOADTS(1,KAGOG)
  1211. C COMPUTED GOTO
  1212.         CALL LOADTS(1,KCGOG)
  1213. C ARITHMETIC IF
  1214.         CALL LOADTS(1,KAIFG)
  1215. C BLOCK IF (IF...THEN)
  1216.         CALL LOADTS(1,KBIFG)
  1217. C ASSIGNMENT STATEMENTS (A = B)
  1218.         CALL LOADTS(1,KASMTG)
  1219.         KTOKG(TNAME)=KASMTG
  1220. C STATEMENT FUNCTION STATEMENTS
  1221.         CALL LOADTS(0,KSFUNG)
  1222. C UNRECOGNIZED STATEMENTS
  1223.         CALL LOADTS(1,KNONEG)
  1224. C ASSERTIONS
  1225.         CALL LOADTS(1,LASRTG)
  1226. C COMMENTS
  1227.         CALL LOADTS(0,LCMNTG)
  1228. C ERRORS IN SOURCE CODE
  1229.         CALL LOADTS(0,LERRG)
  1230. C LINES OF SOURCE CODE
  1231.         CALL LOADTS(0,LLINEG)
  1232. C STATEMENTS OF SOURCE CODE
  1233.         CALL LOADTS(0,LSTMTG)
  1234. *$AS$ (NTYPEG.LE.75)
  1235.  
  1236.         END
  1237. C ----------------------------------------------------------------------
  1238. C
  1239. C       L A B C K S   -   LOOK FOR AND TYPE STATEMENT LABEL FOR
  1240. C                         THIS EXECUTABLE STATEMENT
  1241. C
  1242.  
  1243.         SUBROUTINE LABCKS
  1244.  
  1245. C---------------------------------------------------------
  1246. C    TOOLPACK/1    Release: 2.3
  1247. C---------------------------------------------------------
  1248. C                  LOGICAL VARIABLES
  1249.       COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
  1250.      *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
  1251.      *         HISTG,       IEOFG,       IFDOG,       INSRTG,
  1252.      *         MAING,       SEGMTG,      STOPG,       TRACEG,
  1253.      *         TREEG
  1254.       LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
  1255.      *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
  1256.      *         IEOFG,       IFDOG,       INSRTG,      MAING,
  1257.      *         SEGMTG,      STOPG,       TRACEG,      TREEG
  1258.  
  1259.         SAVE /LOGIC/
  1260.  
  1261. C---------------------------------------------------------
  1262. C    TOOLPACK/1    Release: 2.3
  1263. C---------------------------------------------------------
  1264. C                  CONTROL VARIABLES
  1265.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  1266.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  1267.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  1268.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  1269.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  1270.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  1271.      *         NSTMG,       NTREEG,      NTYPEG
  1272.  
  1273.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  1274.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  1275.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  1276.      +          NTREEG,NTYPEG
  1277.  
  1278.         SAVE /CNTRLC/
  1279.  
  1280. C---------------------------------------------------------
  1281. C    TOOLPACK/1    Release: 2.3
  1282. C---------------------------------------------------------
  1283. C                  MAIN INTEGER STORAGE ARRAYS
  1284. C MAXLBG = Maximum number of DO statement labels per routine
  1285.         INTEGER MAXLBG
  1286.         PARAMETER(MAXLBG=100)
  1287.         COMMON / WORKC   /  IABEG(201),  ICRTNG(200), IPCNTG(75),
  1288.      *         IRCNTG(75),  ISBEG(201),  ISCNTG(75),  INSTG(250),
  1289.      *         KEXECG(75),  LABG(2,MAXLBG), KTOKG(81)
  1290.         INTEGER IABEG,ICRTNG,IPCNTG,IRCNTG,ISBEG,ISCNTG,INSTG,
  1291.      +          KEXECG,LABG,KTOKG
  1292.         SAVE /WORKC/
  1293. C---------------------------------------------------------
  1294. C    TOOLPACK/1    Release: 2.3
  1295. C---------------------------------------------------------
  1296.         COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
  1297.      +                MAXICH
  1298.         INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
  1299.      +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
  1300.      +          MAXICH
  1301.  
  1302.         SAVE /TOKENS/
  1303.  
  1304. C
  1305. C TOKTYP = array of token types for current statement
  1306. C TOKLEN = parallel array of lengths of associated text strings
  1307. C TXTPTR = parallel array of pointers into ISTMG character array of text
  1308. C TOKEN = Current token number within statement being processed
  1309. C NTOKSS = Number of tokens in statement
  1310. C ISTTXT = IST text of token as read in before being converted by ZTOKTX
  1311. C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
  1312. C MAXICH = Last character used in ISTTXT array
  1313. C
  1314. C---------------------------------------------------------
  1315. C    TOOLPACK/1    Release: 2.4
  1316. C---------------------------------------------------------
  1317. C
  1318. C  TKLAST = LAST TOKEN NUMBER
  1319. C
  1320.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  1321.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  1322.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  1323.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  1324.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  1325.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  1326.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  1327.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  1328.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  1329.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  1330.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  1331.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  1332.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  1333.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  1334.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  1335.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  1336.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  1337.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  1338.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  1339.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  1340.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  1341.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  1342.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  1343.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  1344.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  1345.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  1346.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  1347.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  1348.  
  1349.  
  1350.         INTEGER L,KL,LABEL
  1351.  
  1352.         INTEGER CTOI
  1353.         EXTERNAL CTOI
  1354.  
  1355.         LABEL=0
  1356.         IF (TOKTYP(1).EQ.TDCNST) THEN
  1357.             L=1
  1358.             LABEL=CTOI(ISTTXT(ISTPTR(1)),L)
  1359. C LABEL FOUND. SEE IF STATEMENT ENDS A *DO* LOOP
  1360.             IF (NLABG .EQ. MAXLBG) THEN
  1361. C DO-LABEL STORAGE FULL. ASSUME THIS LABEL ENDS *DO*.
  1362.                 LABFLG = 2
  1363.                 CALL SEGMTS(.TRUE.)
  1364.             ELSE
  1365.                 IF (NLABG.GT.0) THEN
  1366.                     DO 110 L=1,NLABG
  1367.                         IF (LABEL.NE.LABG(1,L)) GO TO 110
  1368. C LABEL ENDS *DO* LOOP
  1369.                         LABFLG = 2
  1370. C IF LOOP ACTIVE, LOOP-END IS A SEGMENT
  1371.                        IF (NMSEG.GT.LABG(2,L)) CALL SEGMTS(.TRUE.)
  1372. C REDUCE LABEL ARRAY
  1373.                        IF (NLABG.GT.L) THEN
  1374.                            DO 100 KL=L+1,NLABG
  1375.                                LABG(1,KL-1) = LABG(1,KL)
  1376.   100                      LABG(2,KL-1) = LABG(2,KL)
  1377.                        END IF
  1378.                        NLABG = NLABG - 1
  1379.                        GO TO 120
  1380.   110              CONTINUE
  1381.                 END IF
  1382. C LABEL DOES NOT END *DO* LOOP
  1383.                 LABFLG = 1
  1384.                 CALL SEGMTS(.TRUE.)
  1385.             END IF
  1386.         ELSE
  1387. C NO LABEL FOUND
  1388.             LABFLG = 0
  1389.         END IF
  1390. *$AS$ (SEGMTG .OR. LABFLG.EQ.0 .OR. KEXECG(ITYPEG).EQ.0)
  1391.   120   RETURN
  1392.  
  1393.         END
  1394.